This notebook will demonstrate the process of training a binary perceptron classifier on a toy two-dimensional dataset.

First we must load the dataset.

class1<-read.table("Class1.txt",header=TRUE,sep=",") 
class1.dim<-dim(class1)
class1.label<-rep(1,class1.dim[1])
class1<-cbind(class1,class1.label)
names(class1)<-c("weight","height","label")
class1

weight	height	label
0.132	0.757	1
0.722	0.888	1
0.095	0.804	1
0.633	0.530	1
0.472	0.701	1
0.294	0.183	1
0.179	0.874	1
0.023	0.664	1
0.116	0.978	1
0.054	0.786	1
0.394	0.970	1
0.165	0.372	1
0.654	0.906	1
0.486	0.871	1
0.237	0.691	1
0.584	0.990	1
0.133	0.396	1
0.068	0.234	1
0.114	0.464	1
0.108	0.241	1
0.392	0.697	1
0.049	0.361	1
0.169	0.877	1
0.709	0.863	1
0.046	0.646	1
0.069	0.525	1
0.432	0.841	1
0.366	0.888	1
0.386	0.570	1
0.576	0.912	1
...	...	...
0.577	0.902	1
0.033	0.473	1
0.773	0.938	1
0.303	0.680	1
0.576	0.721	1
0.326	0.989	1
0.407	0.719	1
0.406	0.921	1
0.649	0.905	1
0.579	0.841	1
0.095	0.621	1
0.254	0.646	1
0.093	0.570	1
0.126	0.420	1
0.387	0.710	1
0.063	0.996	1
0.016	0.867	1
0.161	0.885	1
0.010	0.700	1
0.154	0.564	1
0.565	0.961	1
0.340	0.482	1
0.443	0.763	1
0.741	0.948	1
0.339	0.761	1
0.870	0.132	1
0.704	0.564	1
0.842	0.052	1
0.903	0.010	1
0.621	0.691	1

class2<-read.table("Class2.txt",header=TRUE,sep=",")
class2.dim<-dim(class2)
class2.label<-rep(-1,class2.dim[1])
class2<-cbind(class2,class2.label)
names(class2)<-c("weight","height","label")
class2

weight	height	label
0.407	0.347	-1
0.726	0.761	-1
0.644	0.415	-1
0.076	0.143	-1
0.110	0.010	-1
0.907	0.859	-1
0.836	0.211	-1
0.954	0.706	-1
0.807	0.466	-1
0.619	0.489	-1
0.695	0.227	-1
0.629	0.153	-1
0.741	0.613	-1
0.311	0.289	-1
0.465	0.426	-1
0.224	0.102	-1
0.387	0.091	-1
0.896	0.839	-1
0.232	0.243	-1
0.704	0.321	-1
0.383	0.234	-1
0.171	0.001	-1
0.913	0.295	-1
0.922	0.166	-1
0.430	0.404	-1
0.819	0.670	-1
0.318	0.628	-1
0.828	0.412	-1
0.661	0.556	-1
0.509	0.572	-1
...	...	...
0.129	0.123	-1
0.876	0.342	-1
0.481	0.567	-1
0.909	0.804	-1
0.721	0.837	-1
0.662	0.772	-1
0.796	0.566	-1
0.900	0.032	-1
0.702	0.386	-1
0.887	0.003	-1
0.634	0.377	-1
0.686	0.329	-1
0.532	0.630	-1
0.495	0.394	-1
0.633	0.706	-1
0.217	0.330	-1
0.999	0.726	-1
0.945	0.274	-1
0.935	0.321	-1
0.213	0.012	-1
0.165	0.014	-1
0.781	0.607	-1
0.902	0.957	-1
0.868	0.201	-1
0.198	0.006	-1
0.052	0.385	-1
0.433	0.986	-1
0.357	0.554	-1
0.303	0.889	-1
0.061	0.814	-1

class1.2<-rbind(class1,class2)
class1.2

weight	height	label
0.132	0.757	1
0.722	0.888	1
0.095	0.804	1
0.633	0.530	1
0.472	0.701	1
0.294	0.183	1
0.179	0.874	1
0.023	0.664	1
0.116	0.978	1
0.054	0.786	1
0.394	0.970	1
0.165	0.372	1
0.654	0.906	1
0.486	0.871	1
0.237	0.691	1
0.584	0.990	1
0.133	0.396	1
0.068	0.234	1
0.114	0.464	1
0.108	0.241	1
0.392	0.697	1
0.049	0.361	1
0.169	0.877	1
0.709	0.863	1
0.046	0.646	1
0.069	0.525	1
0.432	0.841	1
0.366	0.888	1
0.386	0.570	1
0.576	0.912	1
...	...	...
0.129	0.123	-1
0.876	0.342	-1
0.481	0.567	-1
0.909	0.804	-1
0.721	0.837	-1
0.662	0.772	-1
0.796	0.566	-1
0.900	0.032	-1
0.702	0.386	-1
0.887	0.003	-1
0.634	0.377	-1
0.686	0.329	-1
0.532	0.630	-1
0.495	0.394	-1
0.633	0.706	-1
0.217	0.330	-1
0.999	0.726	-1
0.945	0.274	-1
0.935	0.321	-1
0.213	0.012	-1
0.165	0.014	-1
0.781	0.607	-1
0.902	0.957	-1
0.868	0.201	-1
0.198	0.006	-1
0.052	0.385	-1
0.433	0.986	-1
0.357	0.554	-1
0.303	0.889	-1
0.061	0.814	-1

We then place the data into a dataframe to make it easier to visualize:

d.set<-data.frame(cbind(rep(1,nrow(class1.2)),class1.2))
names(d.set)<-c("bias","weight","height","label")
d.set

bias	weight	height	label
1	0.132	0.757	1
1	0.722	0.888	1
1	0.095	0.804	1
1	0.633	0.530	1
1	0.472	0.701	1
1	0.294	0.183	1
1	0.179	0.874	1
1	0.023	0.664	1
1	0.116	0.978	1
1	0.054	0.786	1
1	0.394	0.970	1
1	0.165	0.372	1
1	0.654	0.906	1
1	0.486	0.871	1
1	0.237	0.691	1
1	0.584	0.990	1
1	0.133	0.396	1
1	0.068	0.234	1
1	0.114	0.464	1
1	0.108	0.241	1
1	0.392	0.697	1
1	0.049	0.361	1
1	0.169	0.877	1
1	0.709	0.863	1
1	0.046	0.646	1
1	0.069	0.525	1
1	0.432	0.841	1
1	0.366	0.888	1
1	0.386	0.570	1
1	0.576	0.912	1
...	...	...	...
1	0.129	0.123	-1
1	0.876	0.342	-1
1	0.481	0.567	-1
1	0.909	0.804	-1
1	0.721	0.837	-1
1	0.662	0.772	-1
1	0.796	0.566	-1
1	0.900	0.032	-1
1	0.702	0.386	-1
1	0.887	0.003	-1
1	0.634	0.377	-1
1	0.686	0.329	-1
1	0.532	0.630	-1
1	0.495	0.394	-1
1	0.633	0.706	-1
1	0.217	0.330	-1
1	0.999	0.726	-1
1	0.945	0.274	-1
1	0.935	0.321	-1
1	0.213	0.012	-1
1	0.165	0.014	-1
1	0.781	0.607	-1
1	0.902	0.957	-1
1	0.868	0.201	-1
1	0.198	0.006	-1
1	0.052	0.385	-1
1	0.433	0.986	-1
1	0.357	0.554	-1
1	0.303	0.889	-1
1	0.061	0.814	-1

plot(d.set[1:nrow(class1),]$weight,d.set[1:nrow(class1),]$height,xlim=c(0:1),ylim=c(0:1),col="red")
points(d.set[nrow(class1)+1:nrow(class1.2),]$weight,d.set[nrow(class1)+1:nrow(class1.2),]$height,col="blue")

Next we will train the perceptron. First we randomize the training data:

samples<-sample(nrow(d.set))
randomized.set<-d.set[samples,]
randomized.set

	bias	weight	height	label
193	1	0.902	0.957	-1
140	1	0.598	0.446	-1
39	1	0.807	0.960	1
20	1	0.108	0.241	1
174	1	0.909	0.804	-1
172	1	0.876	0.342	-1
132	1	0.710	0.347	-1
38	1	0.198	0.955	1
128	1	0.828	0.412	-1
112	1	0.629	0.153	-1
108	1	0.954	0.706	-1
84	1	0.126	0.420	1
96	1	0.870	0.132	1
41	1	0.501	0.901	1
120	1	0.704	0.321	-1
126	1	0.819	0.670	-1
130	1	0.509	0.572	-1
74	1	0.303	0.680	1
45	1	0.229	0.984	1
28	1	0.366	0.888	1
65	1	0.056	0.615	1
81	1	0.095	0.621	1
94	1	0.741	0.948	1
79	1	0.649	0.905	1
83	1	0.093	0.570	1
200	1	0.061	0.814	-1
163	1	0.930	0.890	-1
142	1	0.429	0.414	-1
40	1	0.081	0.758	1
9	1	0.116	0.978	1
...	...	...	...	...
19	1	0.114	0.464	1
117	1	0.387	0.091	-1
179	1	0.702	0.386	-1
170	1	0.664	0.141	-1
99	1	0.903	0.010	1
95	1	0.339	0.761	1
16	1	0.584	0.990	1
154	1	0.261	0.097	-1
29	1	0.386	0.570	1
177	1	0.796	0.566	-1
55	1	0.638	0.911	1
26	1	0.069	0.525	1
6	1	0.294	0.183	1
156	1	0.627	0.600	-1
43	1	0.126	0.326	1
70	1	0.270	0.946	1
183	1	0.532	0.630	-1
148	1	0.904	0.941	-1
100	1	0.621	0.691	1
121	1	0.383	0.234	-1
158	1	0.518	0.440	-1
98	1	0.842	0.052	1
61	1	0.097	0.537	1
33	1	0.084	0.316	1
58	1	0.334	0.576	1
151	1	0.817	0.183	-1
103	1	0.644	0.415	-1
111	1	0.695	0.227	-1
4	1	0.633	0.530	1
93	1	0.443	0.763	1

Then we provide the perceptron learning algorithm:

perceptron <- function(x, eta, niter) {
        
        # initialize weight vector
        weight <- rep(0.1, dim(x)[2]-1)
        errors <- rep(0, niter)
        label.index<-length(x[1,])
        features<-x[,-label.index]
        labels<-x[,label.index]
        
        # loop over number of epochs niter
        for (jj in 1:niter) {
                
                # loop through training data set
                for (ii in 1:nrow(x)) 
                {
                        
                        # Predict binary label using activation function
                        z <- sum(weight[1:length(weight)] * as.numeric(features[ii,])) 
                        if(z < 0) 
                        {
                                ypred <- -1
                        } else {
                                ypred <- 1
                        }
                        
                        # Change weight - the formula doesn't do anything 
                        # if the predicted value is correct
                        weightdiff <- eta * (as.numeric(labels[ii]) - ypred) * as.numeric(features[ii,])
                        weight <- weight + weightdiff
                        
                        # update error rate
                        if ((as.numeric(labels[ii]) - ypred) != 0.0) 
                        {
                                errors[jj] <- errors[jj] + 1
                        }
                        
                }
        }
        
        # weight to decide between the two species 
        print(weight)
        print(errors)
        return(list(v1=weight,v2=errors))
}

Then we execute it using 500 iterations and eta=0.05:

iterations<-500
weight.err <- perceptron(randomized.set, 0.05, iterations)

[1]  0.1000 -0.2757  0.3720
  [1] 55 45 42 41 45 44 44 50 43 46 47 43 47 40 48 43 45 43 45 43 45 43 47 48 43
 [26] 45 43 45 43 45 43 45 43 47 48 43 45 43 45 40 48 43 47 44 43 45 44 43 47 42
 [51] 44 44 46 41 47 45 47 40 48 43 45 43 45 43 47 48 43 42 45 46 41 47 43 43 43
 [76] 47 44 43 47 48 43 45 43 45 43 45 43 45 43 47 48 43 45 43 45 40 48 43 47 44
[101] 43 45 44 43 47 42 44 44 46 41 47 45 47 40 48 43 45 43 45 43 47 48 43 42 46
[126] 45 44 40 43 46 45 40 43 46 45 40 43 47 44 43 47 48 43 45 43 45 43 45 43 45
[151] 43 47 48 43 45 43 45 40 48 43 47 44 43 45 44 43 47 42 44 44 46 41 47 45 47
[176] 40 48 43 45 43 45 43 47 48 43 42 45 46 41 47 43 43 42 40 40 40 40 40 40 40
[201] 40 40 40 40 40 40 45 46 47 45 43 43 47 44 43 47 48 43 45 43 45 40 48 43 47
[226] 43 47 48 43 45 44 43 47 48 43 43 46 43 45 44 43 45 43 45 43 47 44 46 41 47
[251] 43 47 42 44 44 42 45 47 47 49 43 47 40 48 43 45 43 47 48 43 42 46 45 44 40
[276] 43 46 45 40 43 46 45 40 43 47 44 43 47 48 43 45 43 45 43 45 43 45 43 47 48
[301] 43 45 43 45 40 48 43 47 47 49 43 43 44 44 43 45 43 47 48 43 45 43 45 40 48
[326] 43 47 47 49 43 43 44 44 43 45 43 47 48 43 45 43 45 43 45 43 45 43 47 48 43
[351] 45 43 45 40 48 43 47 47 49 43 43 44 44 43 45 43 47 48 43 45 43 45 43 45 43
[376] 45 43 45 43 47 44 46 41 47 45 47 40 48 43 42 45 44 44 43 42 45 44 43 45 46
[401] 43 49 40 48 43 42 46 45 44 40 42 45 47 47 49 43 47 40 48 43 45 40 48 43 47
[426] 45 47 43 47 40 48 43 45 43 45 43 45 43 47 48 43 45 43 45 43 45 43 45 43 47
[451] 48 43 45 43 45 43 45 43 45 43 47 48 43 45 43 45 43 45 43 45 43 47 48 43 45
[476] 43 45 40 48 43 47 43 47 43 47 40 48 43 47 48 43 42 45 46 43 46 45 44 43 45

plot(1:iterations,weight.err$v2)

Then we use the results to plot a decision surface:

plot(d.set[1:nrow(class1),]$weight,d.set[1:nrow(class1),]$height,xlim=c(0:1),ylim=c(0:1),col="red")
points(d.set[nrow(class1)+1:nrow(class1.2),]$weight,d.set[nrow(class1)+1:nrow(class1.2),]$height,col="blue")
slope<-weight.err$v1[2]/weight.err$v1[3]*(-1)
intercept<-weight.err$v1[1]/weight.err$v1[3]*(-1)
abline(intercept,slope,col="green",lty=2)
slope
intercept

0.741129032258194

-0.268817204301081